﻿unit serverMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, System.SyncObjs, Vcl.Graphics, System.Generics.Collections,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls,
  Vcl.StdCtrls,
  IdBaseComponent, IdComponent, IdIPMCastBase, IdIPMCastServer,
  IdCustomTCPServer, IdTCPServer, IdCustomHTTPServer, IdHTTPServer, IdScheduler,
  IdSchedulerOfThread, IdSchedulerOfThreadPool, IdContext, IdTCPConnection,
  IdTCPClient, Vcl.Buttons;

type
  TServerForm = class(TForm)
    Panel2: TPanel;
    Panel4: TPanel;
    AddFileButton: TButton;
    SendFileButton: TButton;
    InfoCastTimer: TTimer;
    ServerInfoCastService: TIdIPMCastServer;
    InfoService: TIdTCPServer;
    ServerFileService: TIdTCPServer;
    FileOpenDialog: TFileOpenDialog;
    CancelSendButton: TButton;
    SpeedButton1: TSpeedButton;
    outputMemo: TMemo;
    FileNameEdit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    CardListBox: TComboBox;
    tickTimer: TTimer;
    logMemo: TMemo;
    serverFileServiceThreadPool: TIdSchedulerOfThreadPool;
    infoServiceThreadPool: TIdSchedulerOfThreadPool;
    hashButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure InfoCastTimerTimer(Sender: TObject);
    procedure InfoServiceExecute(AContext: TIdContext);
    procedure ServerFileServiceExecute(AContext: TIdContext);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SendFileButtonClick(Sender: TObject);
    procedure CancelSendButtonClick(Sender: TObject);
    procedure AddFileButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CardListBoxChange(Sender: TObject);
    procedure tickTimerTimer(Sender: TObject);
    procedure SafeStopIdTCPServer(IdTCPServer: TIdTCPServer);
    procedure hashButtonClick(Sender: TObject);
  private
    { Private declarations }
    ready: boolean;
    tick: uint32;
    fileInfoStrings: TStrings;
    complete: int32;
    completePostion: int32;
    average: extended;
    sliceDataServiceList: array of TThreadList<string>;
    hashList: TArray<uint32>;
    AliveList: TDictionary<string, uint32>;
    AliveLock: TMultiReadExclusiveWriteSynchronizer;
  public
    { Public declarations }
  end;

var
  ServerForm: TServerForm;

implementation

{$R *.dfm}

uses
{$IFDEF DEBUG}
  MadExcept,
{$ENDIF}
  buffer, common, IdException, idGlobal, System.strutils, System.IOUtils,
  System.Math;

procedure TServerForm.AddFileButtonClick(Sender: TObject);
begin
  // 添加文件
  FileOpenDialog.Options := [fdoForceFileSystem, fdoFileMustExist];
  FileOpenDialog.FileName := '';
  if FileOpenDialog.Execute then
  begin
    FileInfo.ServerFileName := FileOpenDialog.FileName;
    FileInfo.FileName := ExtractFileName(FileInfo.ServerFileName);
    FileNameEdit.Text := FileOpenDialog.FileName;
    FileInfo.size := TFile.GetSize(FileInfo.ServerFileName);
    totalSlice := (FileInfo.size + sliceLength - 1) div sliceLength;
    fileInfoStrings.Add(common.fileInfoString);
    fileInfoStrings.Add(FileInfo.FileName);
    fileInfoStrings.Add(FileInfo.size.ToString);

    outputMemo.Lines.Add('文件名: ' + FileInfo.ServerFileName);
    outputMemo.Lines.Add('    文件长度: ' + FileInfo.size.ToString);

    setlength(sliceDataServiceList, totalSlice);
    setlength(hashList, totalSlice);
    for var i := 0 to totalSlice - 1 do
    begin
      sliceDataServiceList[i] := TThreadList<string>.create;
      sliceDataServiceList[i].Add(serverString);
    end;
    InfoCastTimer.Enabled := true;
    AddFileButton.Enabled := false;
    hashButton.Enabled := true;
    average := 0.0;
  end;
end;

procedure TServerForm.CancelSendButtonClick(Sender: TObject);
begin
  // 结束发送文件
  try
    ready := false;
    ServerInfoCastService.Active := false;
    InfoCastTimer.Enabled := false;
    SafeStopIdTCPServer(InfoService);
    SafeStopIdTCPServer(ServerFileService);
    CardListBox.Enabled := true;
    AddFileButton.Enabled := true;
    CancelSendButton.Enabled := false;

    for var item in sliceDataServiceList do
      if Assigned(item) then
        item.free;
    setlength(sliceDataServiceList, 0);
    AliveList.Clear;

    outputMemo.Lines.Add(NowTimeToString + '  ------中断传送------');
    CardListBox.Enabled := true;
  except
    on E: Exception do
      logMemo.Lines.Add('中断传送: ' + E.ToString);
  end;
end;

procedure TServerForm.CardListBoxChange(Sender: TObject);
begin
  var
  i := CardListBox.ItemIndex;
  var
  ipv6Address := IPv6CardList[i].IPv6;
  var
    v: boolean;

  with ServerInfoCastService do
  begin
    v := Active;
    Active := false;
    BoundIP := ipv6Address;
    Active := v;
  end;
end;

procedure TServerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if CancelSendButton.Enabled then
    CancelSendButtonClick(Sender);
end;

procedure TServerForm.FormCreate(Sender: TObject);
begin
  ready := false;
  complete := 0;
  tick := 0;
  fileInfoStrings := TStringList.create;
  AliveList := TDictionary<string, uint32>.create;
  with ServerInfoCastService do
  begin
    Active := false;
    MulticastGroup := common.MulticastGroup;
    Port := InfoCastPort;
  end;

  with InfoService do
  begin
    defaultPort := infoServicePort;
    ListenQueue := 128;
    MaxConnections := 128;
    Active := true;
  end;

  with ServerFileService do
  begin
    defaultPort := ServerFileServicePort;
    ListenQueue := 128;
    MaxConnections := 128;
    Active := false;
  end;

  AliveLock := TMultiReadExclusiveWriteSynchronizer.create;
end;

procedure TServerForm.FormShow(Sender: TObject);
begin
  IPv6CardList := EnumIPv6Card;
  if IPv6CardList.count > 0 then
  begin
    var
      IPv6Card: TIPv6Card;
    for var i := 0 to IPv6CardList.count - 1 do
    begin
      var
      s := IPv6CardList[i].CardName + ' <==> ' + IPv6CardList[i].IPv6;
      CardListBox.Items.Add(s);
    end;
  end;

  CardListBox.ItemIndex := 0;
  CardListBoxChange(self);
end;

procedure TServerForm.hashButtonClick(Sender: TObject);
begin
  var
    fs: TFileStream;
  var
  ok := false;
  try
    try
      fs := TFileStream.create(FileInfo.ServerFileName, fmOpenRead or
        fmShareDenyWrite);
      var
        len: uint64 := 0;
      var
      sliceIndex := 0;
      var
        data: TIdBytes;
      setlength(data, sliceLength);
      while len < FileInfo.size do
      begin
        var
        realLength := min(sliceLength, FileInfo.size - len);
        fs.Read(data[0], realLength);
        var
        hashValue := hashData(data, realLength);
        hashList[sliceIndex] := hashValue;
        ServerInfoCastService.Send(hashString + ' ' + sliceIndex.ToString + ' '
          + hashValue.ToString);
        inc(sliceIndex);
        inc(len, realLength);
      end;
      ok := true;
      outputMemo.Lines.Add('文件slice校验和计算完成，共 ' + totalSlice.ToString + '个');
    except
      on E: Exception do
      begin
        logMemo.Lines.Add('计算文件校验和出错: ' + E.Message);
{$IFDEF DEBUG}
        MadExcept.HandleException(etNormal, E);
{$ENDIF}
      end
    end;
  finally
    freeAndNil(fs);
  end;
  if ok then
  begin
    hashButton.Enabled := false;
    SendFileButton.Enabled := true;
  end;
end;

procedure TServerForm.InfoCastTimerTimer(Sender: TObject);
begin
  // 服务端消息广播
  ServerInfoCastService.Send(magicString);
  if ready then
    ServerInfoCastService.Send(readyString);
end;

procedure TServerForm.SafeStopIdTCPServer(IdTCPServer: TIdTCPServer);
begin
  if not Assigned(IdTCPServer) then
    Exit;

  try
    try
      var
      AList := IdTCPServer.Contexts.LockList;
      for var i := AList.count - 1 downto 0 do
      begin
        if TIdContext(AList[i]).Connection.Connected then
          TIdContext(AList[i]).Connection.Disconnect;
      end;
      IdTCPServer.Active := false;
    except
      on E: Exception do
      begin
        logMemo.Lines.Add('关闭TIdTCPServer时出错: ' + E.Message);
{$IFDEF DEBUG}
        MadExcept.HandleException(etNormal, E);
{$ENDIF}
      end
    end;
  finally
    IdTCPServer.Contexts.UnLockList;
  end;
end;

procedure TServerForm.SendFileButtonClick(Sender: TObject);
begin
  // 开始发送文件
  outputMemo.Lines.Add('开始发送文件');
  ServerFileService.Active := true;
  CardListBox.Enabled := false;
  AddFileButton.Enabled := false;
  CancelSendButton.Enabled := true;
  SendFileButton.Enabled := false;
  outputMemo.Lines.Add('完成主机数: ' + complete.ToString);
  completePostion := outputMemo.Lines.count - 1;
  InfoService.Active := true;
  ready := true;
end;

procedure TServerForm.ServerFileServiceExecute(AContext: TIdContext);
begin
  // 服务端文件数据服务过程
  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
  var
    fs: TFileStream := nil;
  var
    data: TIdBytes;
  var
    l: int32;
  try
    try
      var
      s := AContext.Connection.IOHandler.ReadLn();
      // Memo.Lines.Add('请求命令: ' + s);
      if length(s) = 0 then
        Exit;
      var
      commandString := SplitString(s, ' ');
      if length(commandString) < 2 then
        Exit;
      setlength(data, sliceLength);
      if commandString[0] = common.BlockString then
      begin
        var
          sliceIndex: uint32;
        if TryStrToUInt(commandString[1], sliceIndex) then
          if inRange(sliceIndex, 0, totalSlice - 1) then
          begin
            if not readBuffer(sliceIndex, data, l) then
            begin
              // Memo.Lines.Add('(ServerFileService)缓存未命中');
              fs := TFileStream.create(FileInfo.ServerFileName,
                fmOpenRead or fmShareDenyWrite);

              fs.Seek(sliceLength * sliceIndex, soFromBeginning);
              l := fs.Read(data[0], sliceLength);
              writeBuffer(sliceIndex, data, l);
            end;

            if AContext.Connection.Connected then
              AContext.Connection.IOHandler.Write(data, l);
          end;
      end;
    except
      on E: EIdConnClosedGracefully do;
      on E: Exception do
      begin
        logMemo.Lines.Add('ServerFileService: ' + E.ToString);
{$IFDEF DEBUG}
        MadExcept.HandleException(etNormal, E);
{$ENDIF}
      end;
    end;
  finally
    freeAndNil(fs);
    setlength(data, 0);
  end;
end;

procedure TServerForm.tickTimerTimer(Sender: TObject);
begin
  AtomicIncrement(tick);
  Application.ProcessMessages;
end;

procedure TServerForm.InfoServiceExecute(AContext: TIdContext);
begin
  // 服务端数据信息服务过程
  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
  var
  funcName := '';
  try
    var
    s := AContext.Connection.IOHandler.ReadLn(); // 结束发送后可能出错误？
    if length(s) = 0 then
      Exit;
    var
    commandString := SplitString(s, ' ');
    if length(commandString[0]) = 0 then
      Exit;

    case commandList.IndexOf(commandString[0]) of
      0:
        begin
          funcName := aliveString;
          var
          clientIPString := AContext.Binding.PeerIP;
          AliveLock.BeginWrite;
          AliveList.AddOrSetValue(clientIPString, tick);
          AliveLock.EndWrite;
        end;
      1:
        begin
          funcName := testString;
          // 连通测试
          if AContext.Connection.Connected then
            AContext.Connection.IOHandler.writeln(common.testOKString);
        end;

      2:
        begin
          // 文件信息
          funcName := fileInfoString;
          if AContext.Connection.Connected then
            AContext.Connection.IOHandler.writeln(fileInfoStrings.Text);
        end;

      3:
        begin
          // 文件slice块主机添加
          funcName := addString;

          var
          clientIP := AContext.Binding.PeerIP;
          if length(commandString) < 2 then
            Exit;
          var
            sliceIndex: uint32;
          if TryStrToUInt(commandString[1], sliceIndex) then
            if inRange(sliceIndex, 0, totalSlice - 1) then
            begin
              sliceDataServiceList[sliceIndex].Add(clientIP);
              ServerInfoCastService.Send(atString + ' ' + sliceIndex.ToString +
                ' ' + clientIP);
            end;
        end;

      4:
        begin
          funcName := whereString;
          // 文件slice块定位查询
          if length(commandString) < 2 then
            Exit;
          var
            sliceIndex: uint32;
          if TryStrToUInt(commandString[1], sliceIndex) then
          begin
            var
            l := sliceDataServiceList[sliceIndex];
            var
            IPString := '';

            var
            tmpList := l.LockList;
            var
            selectIndex := Random(tmpList.count);
            IPString := tmpList[selectIndex];
            l.UnLockList;

            if AContext.Connection.Connected then
              AContext.Connection.IOHandler.writeln(atString + ' ' + IPString);
          end;
        end;

      5:
        begin
          funcName := hashString;
          // 文件slice hash查询
          if length(commandString) < 2 then
            Exit;
          var
            sliceIndex: uint32;
          if TryStrToUInt(commandString[1], sliceIndex) then
            if (sliceIndex < totalSlice) and AContext.Connection.Connected then
              AContext.Connection.IOHandler.writeln
                (hashString + ' ' + hashList[sliceIndex].ToString);
        end;

      6:
        begin
          funcName := completeString;
          if length(commandString) > 1 then
          begin
            // 完成计数
            AtomicIncrement(complete);
            var
              speed: extended;
            if tryStrToFloat(commandString[1], speed) then
            begin
              average := average + speed;
              outputMemo.Lines[completePostion] := '完成主机数: ' +
                complete.ToString + ', 平均速度: ' + Format('%.4f', [average/complete]) + 'MB/s';
            end;
          end;
        end;
    end;

  except
    on E: EIdConnClosedGracefully do;
    on E: Exception do
    begin
      logMemo.Lines.Add('InfoService: (' + funcName + ')' + E.ToString);
{$IFDEF DEBUG}
      MadExcept.HandleException(etNormal, E);
{$ENDIF}
    end;
  end;
end;

end.
